10 REM - 'SCAP'
20 REM STOCK CONTROL & PRICING SYSTEM FOR SYSTEM-80 COMPUTER
30 REM COPYRIGHT (C)DICK SMITH ELECTRONICS, 1980
40 REM ALL RIGHTS RESERVED
50 REM This is a recovered version of SCAP from an OCR of the program listing in the manual.
51 REM Edited and debugged initially by Alan Laughton (of the Microbee Technology forum - https://microbeetechnology.com.au/forum/), then by Terry Stewart (http://www.classic-computers.co.nz)
52 REM See the comments in lines 2111 and 4989 which detail changes to the code printed in the manual over and above OCR errors.
53 REM Extra lines containing PRINT statements replace long PRINT strings with a line feed in some places for easier code readability.
54 REM The presence of these extra comments and print statements mentioned above means the program no longer squeezes into 32K RAM. 48K RAM is required.
55 REM Terry Stewart, 8th March, 2026
60 CLEAR750:DEFINTA,C,G-H,J-O,T,W:DIMC(1200)
70 REM SALES TAX CODES/RATES
80 DATA 5:REM 5 =NO.OF TAX CODES USED
90 DATA A,27.5
100 DATA B,15.0
110 DATA C,2.5
120 DATA D,0.0:REM 'NIL TAX' CATEGORY
130 DATA E,0.0:REM 'EXEMPT - SALES TAX NO. PROVIDED' CATEGORY
140 A=10000:PT=A+5:PI=A+6:QI=A+15:DEFUSR0=556
150 PS=A+16:QS=A+46:PD=A+47:QD=A+346:PV=A+347:QV=A+389
160 CLS:GOSUB350
170 ONERRORGOTO4310:GOSUB3170
180 IFPEEK(16408)<>0THENDT$=RIGHT$(STR$(PEEK(16408)),2)+"/"+RIGHT$(STR$(PEEK(16409)),2)+"/"+RIGHT$(STR$(PEEK(16410)),2):GOTO240
190 PRINT@588,"ENTER DATE (DD/MM/YY):";
200 GL=8:GOSUB510:DT$=IN$:IFLEFT$(DT$,3)="???"THENGOSUB4560
210 IFMID$(DT$,3,1)<>"/"ORMID$(DT$,6,1)<>"/"THENDT$="":GOTO190
220 POKE16408,VAL(LEFT$(DT$,2)):POKE16410,VAL(RIGHT$(DT$,2))
230 POKE16409,VAL(MID$(DT$,4,2)):GOTO270
240 IFPEEK(16426)=1THENPOKE16426,0:PRINT@468,"RE-INITIALISING";:GOTO320
250 PRINT@458,"DATE IS SET TO ";CHR$(31);DT$;" . IS THIS RIGHT? ";
260 GL=1:GOSUB510:IFIN$<>"Y"ANDIN$<>"N"THENPRINTCHR$(8);:GOTO260ELSEIFIN$="N"THENPRINT@458,CHR$(31):GOTO190
270 CLS:GOSUB350
280 IFTI=0ORPW$=" "THEN310
290 GOSUB3970:IFLEFT$(P$,3)="???"THENGOSUB4560:GOTO270
300 IFP$<>PW$THENPRINT:PRINT"** UNAUTHORIZED ACCESS TO SYSTEM **":GOSUB2910:CLS:GOSUB350:GOTO290
310 PRINT@448,"INITIALIZING - PLEASE WAIT";CHR$(31)
320 POKE16424,65:LF$=CHR$(10)
330 GOTO3720
340 GOSUB350:GOTO390
350 CLS:PRINTTAB(17)"STOCK CONTROL & PRICING SYSTEM":PRINTTAB(17)STRING$(30,CHR$(131))
360 PRINT@117,DT$:PRINT:RETURN
370 CLS:PRINT@448,"SECURITY PASSWORD FOR YOUR SYSTEM IS: ";CHR$(34);PW$;CHR$(34):PRINT:GOSUB2910:RETURN
380 GOSUB350:PRINTTAB(21)"STOCK STATUS SUMMARY":PRINTTAB(21)STRING$(20,CHR$(131)):PRINT:GOSUB3840:PRINT:GOSUB2890:RETURN
390 PRINT"OPTIONS:":PRINTSTRING$(8,CHR$(131))
400 PRINT"    A. NEW ITEM ENTRY                 B. DISPLAY/UPDATE":PRINT
402 PRINT"    C. ENTER SALES DOCKETS            D. POST SALES DOCKETS":PRINT
404 PRINT"    E. ENTER GOODS RECEIVED           F. ENTER ORDERS PLACED":PRINT
406 PRINT"    G. STOCK STATUS SUMMARY           H. PRINTED REPORTS":PRINT
408 PRINT"    I. BACKUP DATA DISK               @. END OF PROGRAM"
420 PRINT:PRINT"SELECT OPTION--> ";
430 GH=0:GL=1:GOSUB510:IFCF=1THEN470ELSEIFIN$<"A"ORIN$>"K"THENPRINTCHR$(8);:GOTO430
440 GH=1:S$=IN$:ONASC(IN$)-64GOSUB700,940,2130,2300,1600,1610,380,1820,4950
450 IFER=1THENIN$="A":GOTO440
460 IFGD=0THEN340ELSECLS:GOSUB350:PRINT@468,"DATA SAVING IN PROGRESS":GOSUB3290:GOSUB3260:GOTO4370
470 CLS
480 PRINT@448,"ENDING PROGRAM - WAIT FOR 'READY':":PRINT:PRINT:IFER=1THENCLEAR50:ENDELSEGOSUB3290:GOSUB3260:CLEAR50:END
490 PRINT@128,"(HIT@ TO EXIT TO MAIN MENU)";CHR$(30);:RETURN
500 PRINT@128,"(HIT@ TO REDO ENTRY)";CHR$(30);:RETURN
510 IN$="":CF=0:W$=INKEY$:WD=0:WS=WD:WL=WD:IFGL=WDTHEN GL=1
520 PRINTSTRING$(ABS(GL),CHR$(136));STRING$(ABS(GL),CHR$(24));
530 PRINTCHR$(14);:FORW=1TO25:W$=INKEY$:IFW$<>""THEN540ELSENEXT:PRINTCHR$(15);:FORW=1TO25:W$=INKEY$:IFW$<>""THEN540ELSENEXT:GOTO530
540 IFW$="@"THENCF=1:PRINTCHR$(15);:RETURNELSEIFASC(W$)AND224THEN620
550 IFW$<>CHR$(13)THEN570ELSEPRINTSTRING$(ABS(GL)-WL," ");
560 PRINTCHR$(15);:W=25:NEXT:RETURN
570 PRINTCHR$(14);:IFW$=CHR$(24)THENPRINTSTRING$(WL,CHR$(24));:GOTO510
580 IFW$<>CHR$(8)THEN620ELSEIFWL=0THEN530ELSEPRINTCHR$(24);:IFGL>0THEN600ELSEIFPEEK(16418)=44THEN610
590 IFPEEK(16418)=46THENWD=0:GOTO600ELSEIFPEEK(16418)=43ORPEEK(16418)=45THENWS=0
600 IN$=LEFT$(IN$,LEN(IN$)-1)
610 WL=WL-1:POKE16418,136:GOTO530
620 IFABS(GL)=WLTHEN530ELSEIFGL>0THENIFW$>=" "ANDW$<="Z"THEN670
630 IF W$="." AND WD=0THENWD=1:GOTO670
640 IFW$=","THEN PRINTW$;:WL=WL+1:GOTO680
650 IF(W$="-"ORW$="+")ANDWS=0ANDWL=0THENWS=1:GOTO670
660 IFW$<"0"ORW$>"9"THEN530
670 PRINTW$;:IN$=IN$+W$:WL=WL+1
680 IFABS(GL)<>1THEN530
690 IFGH=1THEN530ELSE560
700 CLS:PRINTTAB(20)"NEW ITEM ENTRY":PRINTTAB(20)STRING$(14,CHR$(131)):PRINT
710 IFTI=1200THENCLS:PRINT@468,"SYSTEM IS FULL (1200 ITEMS)":GOSUB2890:RETURNELSEPRINT@A0,CHR$(30);:GOSUB2920:GOSUB490
720 IFGD<>0THENPRINT@295,"(LAST ENTRY: ";I$;")";
730 GL=6:PRINT@A0,;:GOSUB510:IFCF=0THENIS$=IN$ELSERETURN
740 IFIS$=""THEN730
750 NL=0:NH=OE:GOSUB2840:IFK<>0THENPRINT@288,"ITEM NUMBER ON FILE ALREADY";:GOSUB2910:GOTO710ELSEGOSUB500
760 GL=1:PRINT@A1,;:GOSUB510:IFCF=0THENIA$=IN$ELSE700
770 GL=25:PRINT@A2,;:GOSUB510:IFCF=0THENID$=IN$ELSE700
780 IFID$=""THEN770
790 GL=-7:PRINT@A3,; :GOSUB510:IFCF=0THENIP=VAL(IN$)ELSE700
800 IFIN$=""THEN790
810 GL=-7:PRINT@A4,;:GOSUB510:IFCF=0THENIK=VAL(IN$):ELSE700
820 GL=-7:PRINT@A5,;:GOSUB510:IFCF=0THENIQ=VAL(IN$):ELSE700
830 IFIN$=""THEN820
840 GL=1:PRINT@A6,;:GOSUB510:IFCF=0THENIT$=IN$ELSE700
850 GL=-7:PRINT@A7,;:GOSUB510:IFCF=0THENIC=VAL(IN$):GOSUB3410ELSE700
860 GL=2:PRINT@A8,;:GOSUB510:IFCF=0THENIL$=IN$ELSE700
870 GL=-4:PRINT@A9,;:GOSUB510:IFCF=0THENIR%=VAL(IN$)ELSE700
880 GL=-5:PRINT@AA,;:GOSUB510:IFCF=0THENIO=VAL(IN$)ELSE700
890 GL=4:PRINT@AB,;:GOSUB510:IFCF=0THENIV$=IN$ELSE700
900 P1=0:P2=0:GOSUB4530
910 TC#=TC#+IC*IQ:TP#=TP#+IP*IQ:TR#=TR#+IO*IC:TI=TI+1:TB#=TB#+IK*IQ
920 J=TN:GD=1:GOSUB3930:GOSUB3100:GOSUB3130:GOSUB3110:GOSUB3120:GOSUB2990
930 GOSUB3070:GOSUB3000:GOSUB3020:I$=IS$:TN=TN+1:J=TN:ER=0:GOTO710
940 CLS:PRINTTAB(20)"DISPLAY/UPDATE STOCK ITEMS":PRINTTAB(20)STRING$(26,CHR$(131)):PRINT
950 PRINT@AF,CHR$(31);:GOSUB2920
960 PRINT@A0,;
970 GL=6:GOSUB510:IFCF=0THENIS$=IN$ELSE1550
980 GOSUB2830
990 IFK=0THENPRINT@288,"** ITEM NOT ON FILE **";:GOSUB2910:GOSUB2920:GOTO960 
1000 GOSUB3340
1010 PRINT@1,"C HANGE    D ELETE       A DJUST QTY       @ RETURN TO MENU":PRINT@64,CHR$(30)
1020 PRINT@0,CHR$(133);:PRINT@2,CHR$(138);:PRINT@11,CHR$(133);:PRINT@13,CHR$(138);
1030 PRINT@25,CHR$(133);:PRINT@27,CHR$(138);:PRINT@43,CHR$(133);:PRINT@45,CHR$(138);
1040 PRINT@128,CHR$(30);:PRINT" S EARCH    N EXT ITEM    P REVIOUS ITEM";CHR$(30);
1050 PRINT@128,CHR$(133);:PRINT@130,CHR$(138);:PRINT@139,CHR$(133);:PRINT@141,CHR$(138);:PRINT@153,CHR$(133);:PRINT@155,CHR$(138);
1060 PRINT@181,CHR$(133);" ";CHR$(138);
1070 PRINT@192,STRING$(17,CHR$(131));STRING$(10,CHR$(179));STRING$(37,CHR$(131));
1080 PRINT@182,"";
1090 GH=0:GL=1:GOSUB510:IFCF=1THEN1550
1100 O$=IN$:IFO$<>"C"ANDO$<>"S"ANDO$<>"N"ANDO$<>"P"ANDO$<>"D"ANDO$<>"A"THENPRINTCHR$(8);:GOTO1090
1110 IFO$="D"THEN1490
1120 IFO$="S"THEN950
1130 IFO$="C"THEN1180
1140 IFO$="A"THEN1520
1150 IFO$="P"ANDN<>1THENN=N-1:J=C(N):IFSGN(J)=-1THEN1150ELSEGOSUB3100:GOSUB3130:GOSUB3140:GOSUB3340:GOTO1010
1160 IFO$="N"ANDN+1<>TNTHENN=N+1:J=C(N):GOTO1170ELSEPRINTCHR$(8);:GOTO1090
1170 IFSGN(J)=-1THEN1160ELSEGOSUB3100:GOSUB3130:GOSUB3140:GOSUB3340:GOTO1010
1180 PRINT@0,CHR$(30):PRINT@128,CHR$(30);:PRINT@64,"SELECT LINE TO BE CHANGED (HIT @ TO RESTART)--> ";
1190 GL=1:GOSUB510:IFCF=0THENU$=IN$:IFU$<"A"ORU$>"N"THENPRINTCHR$(8);:GOTO1190
1200 IFCF<>0THEN1010
1210 GH=1:ONASC(U$)-65GOTO1220,1250,1270,1300,1320,1340,1360,1390,1410,1430,1450,1460,1470
1220 PRINT@A1," ";:PRINT@A1,;
1230 GL=1:GOSUB510:IFCF=0THENIA$=IN$:GOTO1480ELSE1200
1240 PRINT@128,CHR$(31):PRINT@448,"FORMATTING DESTINATION DISK";
1250 PRIN1@A2,STRING$(25," ");:PRINT@A2,;
1260 GL=25:GOSUB510:IFCF=0THENID$=IN$:GOTO1480ELSE1200
1270 PRINT@A3,STRING$(7," ");:PRINT@A3,;
1280 GL=-7:GOSUB510:IFIN$=""THEN1280ELSEIFCF=0THENGOSUB1580:IP=VAL(IN$):GOSUB3410:GOSUB1590:GOTO1480
1290 GOTO1200
1300 PRINT@A4,STRING$(7," ");:PRINT@A4,;
1310 GL=-7:GOSUB510:IFCF=0THENGOSUB1580:IK=VAL(IN$):GOSUB1590:GOTO1480ELSE1200
1320 PRINT@A5,"     ";:PRINT@A5,;
1330 GL=-5:GOSUB510:IFCF=0THENGOSUB1580:IQ=VAL(IN$):GOSUB1590:GOTO1480ELSE1200
1340 PRINT@A6," ";:PRINT@A6,;
1350 GL=1:GOSUB510:IFCF=0THENIT$=IN$:GOTO1480ELSE1200
1360 PRINT@A7,STRING$(7," "); :PRINT@A7,;
1370 GL=-7:GOSUB510:IFIN$=""THEN1370ELSEIFCF=0THENGOSUB1580:IC=VAL(IN$):GOSUB3410:GOSUB1590:GOTO1480
1380 GOTO1200
1390 PRINT@A8,"  ";:PRINT@A8,;
1400 GL=2:GOSUB510:IFCF=0THENIL$=IN$:GOTO1480ELSE1200
1410 PRINT@A9,"    ";:PRINT@A9,;
1420 GL=-4:GOSUB510:IFCF=0THENIR%=VAL(IN$):GOTO1480ELSE1200
1430 PRINT@AA,"     ";:PRINT@AA,;
1440 GL=-5:GOSUB510:IFCF=0THENGOSUB1580:IO=VAL(IN$):GOSUB1590:GOTO1480ELSE1200
1450 PRINT@AB,"    ";:PRINT@AB,;:GL=4:GOSUB510:IFCF=0THENIV$=IN$:GOTO1480ELSE1200
1460 PRINT@AC,STRING$(7," ");:PRINT@AC,;:GL=-7:GOSUB510:IFCF=0THENGOSUB1560:P1=VAL(IN$):GOSUB1570:GOTO1480ELSE1200
1470 PRINT@AD,STRING$(7," ");:PRINT@AD,;:GL=-7:GOSUB510:IFCF=0THENGOSUB1560:P2=VAL(IN$):GOSUB1570:GOTO1480ELSE1200
1480 GOSUB3020:GOTO1010
1490 PRINT@128,"ARE YOU SURE YOU WANT TO DELETE THIS ITEM (Y/N)? ";:GL=1:GOSUB510:IFIN$<>"Y"THEN1010ELSEC(N)=-J
1500 TI=TI-1:GOSUB1580:G=G+1
1510 PRINT@A0,CHR$(31);:GOSUB2920:GOTO960
1520 PRINT@0,CHR$(30):PRINT@128,CHR$(30);:PRINT@64,"ENTER + OR - AND CHANGE IN QUANTITY---> ";
1530 GL=-5:GOSUB510:IFCF=0THENCH$=IN$ELSE1200
1540 IQ=IQ+VAL(CH$):TC#=TC#+IC*VAL(CH$):TP#=TP#+IP*VAL(CH$):TB#=TB#+IK*VAL(CH$):GOSUB3520:GOTO1480
1550 RETURN
1560 TM#=TM#-P1*IP:TY#=TY#-P1*IP:RETURN
1570 TM#=TM#+P1*IP:TY#=TY#+P1*IP:RETURN
1580 TC#=TC#-IQ*IC:TP#=TP#-IQ*IP:TR#=TR#-IO*IC:TB#=TB#-IK*IQ:RETURN
1590 TC#=TC#+IQ*IC:TP#=TP#+IQ*IP:TR#=TR#+IO*IC:TB#=TB#+IK*IQ:RETURN
1600 CLS:PRINTTAB(22)"ENTER GOODS RECEIVED":PRINTTAB(22)STRING$(20,CHR$(131)):PRINT:GOTO1620
1610 CLS:PRINTTAB(22)"ENTER ORDERS PLACED":PRINTTAB(22)STRING$(19,CHR$(131)):PRINT
1620 PRINT@AF,CHR$(31);:GOSUB2920
1630 GOSUB490
1640 PRINT@A0,;:GL=6:GOSUB510:IFCF=0THENIS$=IN$ELSE1550
1650 GOSUB2830
1660 IFK=0THENPRINT@288,"** ITEM NOT ON FILE **";:GOSUB2910:GOSUB2920:GOTO1630
1670 GOSUB3340
1680 IFS$="F"THEN1790
1690 PRINT@128,"QUANTITY RECEIVED: ";CHR$(30);
1700 GL=-5:GOSUB510:IFCF=0THENGOSUB1580:IQ=IQ+VAL(IN$):IO=IO-VAL(IN$)ELSE1630
1710 IFIO<0THENIO=0
1720 PRINT@128,"NEW SELLING PRICE (HIT <NEW LINE)IF NO CHANGE): ";CHR$(30);
1730 PRINT@A3,STRING$(7," ");:PRINT@A3,;:GL=-7:GOSUB510:IFCF<>0THEN1630ELSEIFIN$=""THENPRINT@A3,USINGL1$;IP;:GOTO1750
1740 IFCF=0THENIP=VAL(IN$)ELSE1720
1750 PRINT@128,"NEW COST PRICE (HIT <NEW LINE)IF NO CHANGE): ";;CHR$(30);
1760 PRINT@A7,STRING$(7," ");:PRINT@A7,;:GL=-7:GOSUB510:IFCF<>0THEN1630ELSEIFIN$=""THENPRINT@A7,USINGL1$;IC;:GOTO1780
1770 IFCF=0THENIC=VAL(IN$)ELSE1750
1780 GOSUB1590:GOSUB3020:GOSUB2920:GOSUB3520:GOTO1630
1790 PRINT@128,"QUANTITY ORDERED: ";CHR$(30);
1800 GL=-5:GOSUB510:IFCF<>0THEN1630ELSEGOSUB1580:IO=IO+VAL(IN$)
1810 GOTO1780
1820 CLS:PRINTTAB(25)"PRINTED REPORTS":PRINTTAB(25)STRING$(15,CHR$(131)):PRINT
1830 PRINT"OPTIONS:":PRINT"1 - PRICE LIST"
1832 PRINT"2 - STOCK STATUS REVIEW":PRINT"3 - LISTING OF NOT-IN-STOCK ITEMS"
1834 PRINT"4 - LISTING OF ITEMS ON ORDER":PRINT"5 - LISTING OF ITEMS LESS THAN MINIMUM BALANCE"
1836 PRINT"6 - LISTING OF ITEMS BY SUPPLIER"
1840 PRINT"7 - STOCK COUNT SHEET":PRINT"8 - STOCK TAKE ANALYSIS"
1845 PRINT"@ - EXIT TO MAIN MENU"
1850 PRINT:PRINT"SELECT OPTION--> ";
1860 GH=0:GL=-1:GOSUB510:IFCF=1THENRETURNELSEO$=IN$:IFO$<"1"ORO$>"8"THENPRINTCHR$(8);:GOTO1860
1870 O=VAL(O$):CC=0:IFO=1THENGOSUB3680
1880 IFO=8THEN4650
1890 PRINT:PRINT"ENTER DESIRED PREFIX (OR HIT <NEW LINE)FOR ALL ITEMS): ";:GL=2:GOSUB510:K$=IN$
1900 POKE16425,0:GOSUB4430:GOSUB4270
1910 GOSUB3710:GOSUB3670
1920 ONOGOSUB4040,4110,4140,4170,4200,4230,4610
1930 IFO>1ANDO<7THENGOSUB3550:GOTO1950
1940 IFO=1THENGOSUB4450
1950 FORN=1TOTN-1
1960 J=C(N):IFSGN(J)=-1THEN1990
1970 ONOGOSUB4050,4120,4150,4180,4210,4250,3650
1980 EN$=INKEY$:IFEN$="@"THENLPRINT" ":LPRINT"   * TERMINATED *":N=TN-1
1990 NEXT
2000 LPRINT" ":LPRINT"ITEMS LISTED :";TAB(49)USINGL0$;TT:GOSUB4380
2010 IFCC=0ANDO<>4THENLPRINT"COST VALUE OF LISTED ITEMS :";TAB(40);USINGL6$;T1#
2020 IFO<>4THENLPRINT"RETAIL VALUE OF LISTED ITEMS :";TAB(40);USINGL6$;T2#:GOSUB4380
2030 IFO=1ANDCC=0THENLPRINT"BULK VALUE OF LISTED ITEMS:";TAB(40)USINGL6$;T4#
2040 IFO>1ANDO<7THENLPRINT"COST OF ABOVE GOODS ON ORDER :";TAB(40);USINGL6$;T3#:GOSUB4380
2050 IFO=2THENLPRINT"TOTAL SALES THIS MONTH (ALL ITEMS):";TAB(40)USINGL6$;TM#
2060 IFO=2THENLPRINT"TOTAL SALES YR TO DATE (ALL ITEMS):";TAB(40)USINGL6$;TY#
2070 GOSUB4030:GOTO1820
2080 GOSUB3100:GOSUB3130:GOSUB3140:RETURN
2090 GOSUB2990:GOSUB3070:GOSUB3080:RETURN
2100 REM INITIALIZE NEW SYSTEM
2110 TC#=0:TP#=0:TB#=0:TM#=0:TY#=0:TR#=0:TI=0:TN=1:HI=0:HN=1:G=0:ER=1:OE=1
2111 REM The original line 2110 in the manual excludes OE=1. I've added it stop an illegal call error being triggered on the very first data entry on a blank data disk
2120 RETURN
2130 CLS:PRINTTAB(22)"ENTER SALES DOCKETS":PRINTTAB(22)STRING$(19,CHR$(131)):PRINT
2140 H=HN:HC=0
2150 IFHI<1200THEN2170
2160 CLS:PRINT@448,"SALES FILE IS FULL (1200 ITEMS). USE MENU OPTION 'D' TO POST SALES AND CLEAR THE FILE":GOSUB2910:RETURN
2170 GOSUB490
2180 PRINT@259,"ITEM NUMBER   ";CHR$(191);"        ";CHR$(191),CHR$(31);:GOSUB2960
2190 IFHC<>0THENPRINT@297,"(LAST ENTRY: ";HA$;")";
2200 PRINT@275,;
2210 GL=6:GOSUB510:IFCF=0THENHA$=IN$ELSERETURN
2220 GOSUB500:PRINT@384,"QUANTITY SOLD : ";
2230 GL=-4:GOSUB510:IFCF=0THENHB=VAL(IN$)ELSE2170
2240 PRINT@512,"AT RETAIL PRICE OR BULK PRICE? (R/B)  ";CHR$(31);
2250 GL=1:GOSUB510:IFCF=0THENIT$=IN$ELSE2170
2260 IFIT$=""THENIT$="R"
2270 IFIT$<>"B"ANDIT$<>"R"THEN2240
2280 GOSUB2770:GOSUB2810:GOSUB2780:GOSUB2790
2290 HI=HI+1:HN=HN+1:H=HN:HC=1:GOTO2150
2300 CLS:PRINTTAB(13)"POST SALES DOCKETS/CLEAR SALES FIGURES":PRINTTAB(13)STRING$(38,CHR$(131)):PRINT
2310 PRINT@128,"FUNCTIONS":PRINT"1 - POST SALES DOCKETS"
2312 PRINT"2 - CLEAR M.T.D. SALES FIGURES FROM EACH STOCK ITEM":PRINT"3 - CLEAR M.T.O. AND Y.T.D. SALES FIGURES FROM EACH ITEM"
2314 PRINT"@ - EXIT TO MAIN MENU":PRINT
2320 PRINT"SELECT FUNCTION>";
2330 GH=0:GL=-1:GOSUB510:IFCF=1THENRETURNELSEHO$=IN$:IFHO$<"1"ORHO$>"3"THENPRINTCHR$(8);:GOTO2330
2340 PRINT"  ARE YOU SURE (Y/N)";:GL=1:GOSUB510:IFIN$<>"Y"THEN2300
2350 ONVAL(HO$)GOTO2360,2650,2670
2360 GOSUB4430
2370 IFHI=0THENCLS:PRINT@460,"NO UNPOSTED SALES DOCKETS IN FILE":GOSUB2910:GOTO2300ELSEGOSUB2530
2380 PRINT@320,CHR$(131):PRINT@468,"POSTING IN PROGRESS";CHR$(31)
2390 HT=HI:HC#=0:HK#=0:HV#=0
2400 FORH=1TOHI
2410 GOSUB2770:GOSUB2810:GOSUB2820:IS$=HA$
2420 GOSUB2830:IFK=0THENGOSUB2560:GOTO2510
2430 GOSUB2990:GOSUB3070:GOSUB3080
2440 IFH3$="B"THENI=IK:HK#=HK#+HB*IKELSEI=IP:HC#=HC#+HB*IP
2450 P1=P1+HB:P2=P2+HB:HV#=HV#+HB*IC
2460 TM#=TM#+HB*I:TY#=TY#+HB*I
2470 IQ=IQ-HB:TC#=TC#-HB*IC:TP#=TP#-HB*IP:IFIQ<0THENGOSUB2580
2480 LPRINTIS$"  ";IA$;"  ";ID$;"  ";IT$;"  ";USINGL1$;I;:LPRINT" ";H3$;" ";USINGL0$;HB;
2490 LPRINTUSINGL0$;IQ;:LPRINTUSINGL0$+"##  ";P1;P2
2500 GOSUB3020:HT=HT-1:PRINT@596,"DOCKETS REMAINING : ";HT
2510 NEXT:GOSUB2590
2520 HI=0:HN=1:GOTO2300
2530 GOSUB3670:LPRINTCHR$(14);TAB(2)"SALES DOCKET POSTING REPORT ";DT$;CHR$(15):LPRINTLF$
2540 LPRINT"Item    A  D e s c r i p t i o n      T  Selling     Qty   New   Sold   Sold"
2550 LPRINT"Number  D                             X   Price     Sold   Bal   MTD    YTD":RETURN
2560 LPRINTCHR$(14);"ERROR:";CHR$(15);" ITEM NUMBER ";HA$;" IS NOT IN STOCK FILE AND WAS NOT POSTED":LPRINTLF$
2570 RETURN
2580 LPRINTCHR$(14);"NOTE:";CHR$(15);" ITEM NUMBER ";HA$;" NOW HAS A QUANTITY OF ";IQ:LPRINTLF$:RETURN
2590 LPRINT" ":LPRINT"NUMBER OF ITEMS POSTED : ";HI-HT
2600 LPRINT"REVENUE FROM RETAIL SALES : ";USINGL6$;HC#
2610 LPRINT"REVENUE FROM BULK SALES :   ";USINGL6$;HK#
2620 LPRINT"TOTAL REVENUE :             ";USINGL6$;HK#+HC#
2630 LPRINT" ":LPRINT"TOTAL COST OF GOODS SOLD:   ";USINGL6$;HV#
2640 GOSUB4030:RETURN
2650 CLS:PRINT@463,"CLEARING MONTH TO DATE SALES FIGURES"
2660 GOSUB2690:GOTO2300
2670 CLS:PRINT@458,"CLEARING MONTH-TO-DATE AND YEAR-TO-DATE SALES FIGURES"
2680 GOSUB2690:GOTO2300
2690 FORJ=1TOTN-1
2700 GOSUB2990:GOSUB3070:GOSUB3080
2710 IFHO$="3"THENP2=0
2720 PRINT@630,J
2730 P1=0
2740 GOSUB3020:NEXT
2750 TM#=0:IFHO$="3"THENTY#=0
2760 RETURN
2770 HR=INT((H-1)/28)+1:HD=H-28*INT((H-1)/28)-1
2780 DEF FIELD#1,HD*9 AS D$,6 AS H1$,2 AS H2$,1 AS H3$,(28-HD-1)*9 AS DY$:RETURN
2790 LSETH1$=HA$:RSETH2$=MKI$(HB):LSETH3$=IT$
2800 IFPV+HR-1>QVTHEN4365ELSEPUT#1,PV+HR-1:RETURN
2810 IFPV+HR-1>QVTHEN4365ELSEGET#1,PV+HR-1:RETURN
2820 HA$=H1$:HB=CVI(H2$):RETURN
2830 NL=0:NH=TN
2840 K=INT((NH-NL)/2):IFK=0THENRETURNELSEN=K+NL
2850 J=ABS(C(N)):GOSUB3100:GOSUB3130:IFIS$+STRING$(6-LEN(IS$)," ")=N$THENIS$=N$:GOTO2880
2860 IFIS$+STRING$(6-LEN(IS$)," ")<N$THENNH=N:GOTO2840
2870 NL=N:GOTO2840
2880 IFSGN(C(N))=-1THENK=0:RETURNELSERETURN
2890 PRINTTAB(10)"HIT @ TO RETURN TO MAIN MENU--> ";
2900 GL=1:GOSUB510:IFCF=1THENRETURNELSEPRINTCHR$(8);:GOTO2900
2910 FORT=1TO2500:NEXT:RETURN
2920 PRINT@256,"A. ITEM NUMBER   ";CHR$(191);"        ";CHR$(191);CHR$(31)
2930 PRINT@360,"B. ADN CODE";:PRINT@384,"C. DESCRIPTION":PRINT"D. SELLING PRICE"
2932 PRINT"F. QTY ON HAND":PRINT"H. COST PRICE"
2934 PRINT"J. MIN. BALANCE":PRINT"L. SUPPLIER"
2940 PRINT@488,"E. BULK PRICE";:PRINT@552,"G. TAX CODE";:PRINT@616,"I. LOCATION";:PRINT@680,"K. QTY ON ORDER";
2950 PRINT@768,"M. SALES MTD";:PRINT"N. SALES YTD"
2960 FORI=209TO218:POKE15360+I,176:NEXTI
2970 FORI=337TO346:POKE15360+I,131:NEXTI
2980 RETURN
2990 JR=INT((J-1)/4)+1:JD=J-4*INT((J-1)/4)-1
3000 DEF FIELD #3,(JD*63) AS D$,1 AS FA$,25 AS FD$,4 AS FP$,4 AS FK$,4 AS FQ$,1 AS FT$,4 AS FC$
3010 DEF FIELD #3,(JD*63)+43 AS D$,2 AS FL$,2 AS FR$,4 AS FO$,4 AS FV$,4 AS P1$,4 AS P2$,(4-JD-1)*63 AS DY$:RETURN
3020 LSETFD$=ID$:RSETFQ$=MKS$(IQ):RSETFC$=MKS$(IC)
3030 RSETFP$=MKS$(IP):LSETFL$=IL$:RSETFR$=MKI$(IR%)
3040 RSETFO$=MKS$(IO):LSETFV$=IV$:RSETP1$=MKS$(P1):RSETP2$=MKS$(P2)
3050 LSETFA$=IA$:LSETFT$=IT$:LSETFK$=MKS$(IK)
3060 IFPD+JR-1>QDTHEN4365ELSEPUT #3,PD+JR-1:RETURN
3070 IFPD+JR-1>QDTHEN4365ELSEGET #3,PD+JR-1:RETURN
3080 IA$=FA$:ID$=FD$:IK=CVS(FK$):IQ=CVS(FQ$):IC=CVS(FC$):IP=CVS(FP$):IL$=FL$
3090 IT$=FT$:IR%=CVI(FR$):IO=CVS(FO$):IV$=FV$:P1=CVS(P1$):P2=CVS(P2$):RETURN
3100 JR=INT((J-1)/42)+1:JD=J-42*(JR-1)-1
3110 DEF FIELD #2,(JD*6) AS D$,6 AS N$,((42-JD-1)*6) AS DY$:RETURN
3120 LSETN$=IS$:IFPS+JR-1>QSTHEN4365ELSEPUT#2,PS+JR-1:RETURN
3130 IFPS+JR-1>QSTHEN4365ELSEGET #2,PS+JR-1:RETURN
3140 IS$=N$:RETURN
3150 DEF FIELD #1,8 AS I$,8 AS I0$,8 AS I1$,8 AS J2$,8 AS I2$,8 AS J3$,8 AS J4$,2 AS I3$
3160 DEF FIELD #1,58 AS D$,2 AS I4$,2 AS I5$,2 AS I6$,2 AS I7$,8 AS I8$,25 AS I9$,1 AS J1$:RETURN
3170 GOSUB3150:GET #1,PT
3180 TC#=CVD(I0$):TP#=CVD(I1$):TR#=CVD(I2$):TI=CVI(I3$):HI=CVI(I4$):TN=CVI(I5$):HN=CVI(I6$):G=CVI(I7$):PW$=I8$:CN$=I9$:ST$=J1$
3190 TB#=CVD(J2$):TM#=CVD(J3$):TY#=CVD(J4$):OE=TN
3194 FORW=1TO7:IFRIGHT$(PW$,1)=" "THENPW$=LEFT$(PW$,LEN(PW$)-1)
3196 NEXTW
3200 IFTI=0ORLOF(1)=0ORI$<>"SCPSDATA"THENGOTO3750ELSERETURN
3210 RESTORE:READNC:DIMSX$(NC),SX(NC):FORI=1TONC:READSX$(I):READSX(I):NEXTI
3220 READA0,A1,A2,A3,A4,A5,A6,A7,A8,A9,AA,AB,AC,AD,AE,AF,L0$,L1$,L6$,L7$
3230 N3=0:FORN=1TOTN-1:N1=INT((N-1)/127)+1:IFN1<>N3THENN3=N1:GET#1,PI+N1-1:PRINT@500,N;
3240 N2=N-(N1-1)*127-1:DEF FIELD #1,(N2*2) AS DX$,2 AS DC$
3250 G=USR0(0):C(N)=CVI(DC$):NEXTN:RETURN
3260 N3=1:FORN=1TOTN-1:N1=INT((N-1)/127)+1:IFN3<>N1THENPUT #1,PI+N3-1:N3=N1:PRINT@500,N;
3270 N2=N-(N1-1)*127-1:DEF FIELD #1,(N2*2) AS DX$,2 AS DC$
3280 G=USR0(0):LSETDC$=MKI$(C(N)):NEXTN:PUT #1,PI+N1-1:RETURN
3290 GOSUB3150:LSETI0$=MKD$(TC#):LSETI1$=MKD$(TP#):LSETI2$=MKD$(TR#)
3300 LSETI3$=MKI$(TI):LSETI4$=MKI$(HI):LSETI5$=MKI$(TN)
3310 LSETI6$=MKI$(HN):LSETI7$=MKI$(G):LSETI8$=PW$:LSETI9$=CN$:LSETJ1$=ST$
3320 LSETJ2$=MKD$(TB#):LSETJ3$=MKD$(TM#):LSETJ4$=MKD$(TY#):LSETI$="SCPSDATA"
3330 PUT #1,PT:RETURN
3340 GOSUB2990:GOSUB3070:GOSUB3080:PRINT@A0,IS$;:GOSUB3520:RETURN
3350 DATA275,376,403,467,504,531,568,595,632,659,696,723,787,851,1000,192
3360 PRINT@AF,CHR$(30):RETURN
3370 DATA"#####"
3380 DATA"####.##"
3390 DATA"$$#,###,###.##"
3400 DATA"###.#"
3410 PRINT@AE,"GROSS PROFIT= ";:GOSUB3420:GOTO3460
3420 IFIP=0THENB=0:GOTO3450ELSEB2=0:FORI=1TONC:IFIT$=SX$(I)THENB2=SX(I):NEXTIELSENEXTI
3430 B1=IC:IFST$="U"THENB1=(1+B2/100)*B1
3440 B=(IP-B1)/IP*100
3450 RETURN
3460 IFIP=0ORB>100ORB<0THENPRINT"*****";:RETURN
3470 PRINTUSINGL7$;B;:PRINT" %";:RETURN
3480 IFCC=1THENLPRINT"  ****";:RETURN
3490 GOSUB3420
3500 IFIP=0ORB>100ORB<0THENLPRINT" *****";:RETURN
3510 LPRINT" ";USINGL7$;B;:RETURN
3520 PRINT@A1,IA$;:PRINT@A2,ID$;:PRINT@A3,USINGL1$;IP;:PRINT@A4,USINGL1$;IK;:GOSUB3410
3530 PRINT@A5,IQ;:PRINT@A6,IT$;:PRINT@A7,USINGL1$;IC;:PRINT@A8,IL$;:PRINT@A9,IR%;:PRINT@AA,IO;:PRINT@AB,IV$;:GOSUB4530
3540 RETURN
3550 LPRINT"Item    A  Supl";TAB(45);"Min   On    On   Loc     Unit     Sold     Sold  NMO"
3560 LPRINT"Number  D        D e s c r i p t i o n       Bal   Hand Order         Cost     Month     YTD"
3570 LPRINT" ":RETURN
3580 GOSUB4380:LPRINTIS$;"  ";IA$;"  ";IV$;"  ";ID$;USINGL0$+" ";IR%;IQ;IO;
3590 LPRINT"   ";IL$;"  ";USINGL1$;IC;
3600 LPRINT"  ";USING"####### ";P1;P2;
3610 LPRINT"  ";:IFIQ<=0THENLPRINT"N";ELSELPRINT"-";
3620 IFIQ<=IR%THENLPRINT"M";ELSELPRINT"-";
3630 IFIO>0THENLPRINT"O"ELSELPRINT"-"
3640 RETURN
3650 GOSUB2080:IFK$<>""THENIFLEFT$(IS$,LEN(K$))<>K$THENRETURN
3660 GOSUB2090:GOSUB4280:GOSUB4380:LPRINTIS$;"  ";IA$;"  ";ID$;"  ";IL$;"    ";STRING$(20,".");"    ";USINGL0$;IQ:RETURN
3670 LPRINTCHR$(14);CHR$(25);CN$:RETURN
3680 CLS:PRINT@456,"DO YOU WANT TO SUPPRESS COST AND PROFIT FIGURES ? ";
3690 GL=1:GOSUB510:IFIN$<>"Y"ANDIN$<>"N"THENPRINTCHR$(8);:GOTO3690
3700 IFIN$="N"THENCC=0:RETURNELSECC=1:RETURN
3710 PRINT@128,CHR$(31):PRINT@470,"** PRINTING **":RETURN
3720 GOSUB3210:IFER=1THENIN$="A":GOTO440
3730 PRINT@128,CHR$(31);
3740 GOTO340
3750 PRINT@448,CHR$(30);CHR$(29);"STOCK CONTROL & PRICING SYSTEM - INITIALIZATION":PRINT
3760 PRINT@576,"ENTER COMPANY NAME: ";CHR$(31);:GL=25:GOSUB510:IFIN$=""THENPRINTSTRING$(25,CHR$(24));CN$ELSECN$=IN$
3770 PRINT:PRINT"SALES TAX FACILITY TO BE USED (I.E. SALES TAX IS ADDED TO THE"
3772 PRINT"COST PRICE FOR EACH ITEM, BEFORE G.P. MARGIN IS CALCULATED)"
3774 PRINT"      *** 'U' = TO BE USED *** ' ' = NOT TO BE USED         :";
3780 GL=1:GOSUB510:IFIN$<>"U"ANDIN$<>" "ANDIN$<>""THENPRINTCHR$(8);:GOTO3780
3790 IFIN$=""THENPRINTST$ELSEST$=IN$
3800 PRINT:PRINT"ENTER SECURITY PASSWORD"
3805 PRINT"(IF FEATURE NOT REQUIRED, ENTER SPACES): ";:GL=8:GOSUB510:IFIN$=""THENPRINTPW$ELSEPW$=IN$
3810 IFTI=0ORLOF(1)=0THENGOSUB2110
3820 PRINT:PRINTTAB(10)"ABOVE INFORMATION CORRECT (Y/N)? ";:GL=1:GOSUB510:IFIN$<>"Y"THENPRINT@448,CHR$(31):GOTO3760
3825 IF PW$="        " THEN PW$=" "
3830 GOSUB3290:CLS:RETURN
3840 PRINT"NUMBER OF ITEMS CURRENTLY ON DISKETTE: ";USINGL0$;TI
3850 PRINT"NUMBER OF UNPOSTED DOCKETS:            ";USINGL0$;HI
3860 PRINT"TOTAL RETAIL VALUE          : ";USINGL6$;TP#
3870 PRINT"TOTAL BULK VALUE            : ";USINGL6$;TB#
3880 PRINT"TOTAL COST VALUE            : ";USINGL6$;TC#
3890 PRINT"TOTAL VALUE OF ITEMS ORDERED: ";USINGL6$;TR#
3900 PRINT"TOTAL VALUE OF SALES M-TO-DT: ";USINGL6$;TM#
3910 PRINT"TOTAL VALUE OF SALES YR-T-DT: ";USINGL6$;TY#
3920 RETURN
3930 IFG=0THENC(J)=J:RETURN
3940 FORN=1TOTN-1
3950 IFSGN(C(N))=-1THENC(N)=ABS(C(N)):J=C(N):TN=TN-1:G=G-1:RETURN
3960 NEXT:RETURN
3970 PRINT@463,"ENTER SECURITY PASSWORD---> ";
3980 P$="":FORX=1TO8
3990 PE$=INKEY$:IFPE$=""THEN3990ELSEIFASC(PE$)=13THENX=8:NEXTX:RETURN
4000 IFPE$<" "ORPE$>"["THEN3990
4010 P$=P$+PE$:PRINTCHR$(143);:GOTO4020
4020 NEXT:RETURN
4030 LPRINT" ":LPRINTCHR$(14);"END OF LISTING";CHR$(15):LPRINTCHR$(12):RETURN
4040 LPRINTCHR$(14);CHR$(25);"PRICE LIST  ";DT$;CHR$(15):RETURN
4050 GOSUB2080:IFK$<>""THENIFLEFT$(IS$,LEN(K$))<>K$THENRETURN
4060 GOSUB2090:GOSUB4380:GOSUB4280:LPRINTIS$;" ";IA$;"  ";ID$;"  ";IT$;"  ";USINGL1$+" ";IP;IK;
4070 IFCC=1THENLPRINT:RETURN
4080 LPRINTUSINGL0$+" ";IQ;
4090 LPRINTUSINGL1$+" ";IC;:GOSUB3490
4100 LPRINT" ";IV$:RETURN
4110 LPRINTCHR$(14);CHR$(28);"STOCK STATUS REPORT  ";DT$;CHR$(15):RETURN
4120 GOSUB2080:IFK$<>""THENIFLEFT$(IS$,LEN(K$))<>K$THENRETURN
4130 GOSUB2090:GOSUB3580:GOSUB4280:RETURN
4140 LPRINTCHR$(14);CHR$(28);"LISTING OF NOT-IN-STOCK ITEMS  ";DT$;CHR$(15):RETURN
4150 GOSUB2080:IFK$<>""THENIFLEFT$(IS$,LEN(K$))<>K$THENRETURN
4160 GOSUB2090:IFIQ>0THENRETURNELSEGOSUB3580:GOSUB4280:RETURN
4170 LPRINTCHR$(14);CHR$(28);"LISTING OF ITEMS ON ORDER  ";DT$;CHR$(15):RETURN
4180 GOSUB2080:IFK$<>""THENIFLEFT$(IS$,LEN(K$))<>K$THENRETURN
4190 GOSUB2090:IFIO<=0THENRETURNELSEGOSUB3580:GOSUB4280:RETURN
4200 LPRINTCHR$(14);CHR$(28);"ITEMS LESS THAN MINIMUM BALANCE  ";DT$;CHR$(15):RETURN
4210 GOSUB2080:IFK$<>""THENIFLEFT$(IS$,LEN(K$))<>K$THENRETURN
4220 GOSUB2090:IFIQ>IR%THENRETURNELSEGOSUB3580:GOSUB4280:RETURN
4230 GOSUB4290:GOSUB3710:LPRINTCHR$(14);CHR$(28);"LISTING OF ITEMS BY SUPPLIER: "; IX$;"   ";DT$;CHR$(15)
4240 RETURN
4250 GOSUB2080:IFK$<>""THENIFLEFT$(IS$,LEN(K$))<>K$THENRETURN
4260 GOSUB2090:IFLEFT$(IV$,LEN(IX$))<>IX$THENRETURNELSEGOSUB4280:GOSUB3580:RETURN
4270 TT=0:T1#=0:T2#=0:T3#=0:T4#=0:RETURN
4280 TT=TT+1:T1#=T1#+IQ*IC:T2#=T2#+IQ*IP:T3#=T3#+IO*IC:T4#=T4#+IK*IQ:RETURN
4290 CLS:PRINT@450,"ENTER ENOUGH LETTERS TO IDENTIFY VENDOR--> ";
4300 GL=6:GOSUB510:IX$=IN$:RETURN
4310 REM ERROR HANDLING ROUTINE
4320 IFERR/2+1=33THENCLS:PRINT@458,"SCPS REQUIRES MINIMUM OF 2 DISK DRIVES - 0 AND 1":CLEAR50:END
4330 IFERR/2+1=27THENCLS:PRINT@458,"DISK IN DRIVE #1 IS WRITE PROTECTED - RUN TERMINATED":CLEAR50:PRINT:PRINT:END
4340 IFERR/2+1=34ORERR/2+1=26THENCLS:PRINT@458,"DISK I/O ERROR - RE-RUN PROGRAM.  "
4345 PRINT"IF ERROR PERSISTS, USE BACKUP COPY OF DISK":GOSUB2910:GOTO470
4350 IFERR/2+1=29THENCLS:PRINT@458,"NO DISK IN DRIVE #1 - RUN TERMINATED":CLEAR50:PRINT:PRINT:END
4360 PRINT:PRINTCHR$(30);"UNEXPECTED ERROR CODE ";ERR/2+1;"IN LINE";ERL:GOSUB2910:GOTO480
4365 PRINT:PRINTCHR$(31);"DATA HAS BEEN CORRUPTED ON DATA DISK"
4367 PRINT"GO BACK TO BACK-UP DISK & REPROCESS.":CLEAR50:END
4370 POKE16426,1:CLEAR50:LOAD 335,R
4380 IFPEEK(16425)<59THENRETURNELSELPRINTCHR$(12):GOSUB3670
4390 ONOGOSUB4040,4110,4140,4170,4200,4230,4610
4400 IFO=1THENGOSUB4450:RETURN
4410 IFO=8THENGOSUB4740:RETURN
4420 GOSUB3550:RETURN
4430 PRINT:PRINT"TURN PRINTER ON, AND ALIGN PAPER AT TOP OF PAGE":PRINT"HIT SPACE BAR WHEN READY";CHR$(30);
4440 GL=1:GH=0:GOSUB510:RETURN
4450 LPRINT;"Item    A";TAB(37);"T Selling    Bulk  ";
4460 IFCC=1THENLPRINT:GOTO4490
4470 LPRINT" On     Cost    GP% ";
4480 LPRINT"Supl"
4490 LPRINT"Number  D  D es  c r i p t i o n     X   Price   Price  ";
4500 IFCC=1THENLPRINT:RETURN
4510 LPRINT"Hand   Price"
4520 LPRINT" ":RETURN
4530 PRINT@771,"SALES MTD      ";P1;
4540 PRINT@835,"SALES YTD      ";P2;
4550 RETURN
4560 CLS:PRINT@448,"COMPANY NAME IS: ";CHR$(34);CN$;CHR$(34):PRINT:PRINT"SALES TAX FACILITY (TAX ADDED TO COST PRICE BEFORE"
4565 PRINT"CALCULATING G.P.%): ";CHR$(34);ST$;CHR$(34);" ";
4570 IFST$="U"THENPRINT " (USED)"ELSEPRINT" (NOT USED)"
4580 PRINT:PRINT"SECURITY PASSWORD FOR YOUR SYSTEM IS: ";CHR$(34);PW$;CHR$(34)
4590 PRINT:PRINT"DO YOU WISH TO CHANGE ANY OF THE ABOVE(Y/N)? ";:GL=1:GOSUB510:IFIN$<>"Y"THENGOSUB350:RETURN
4600 PRINT@192,"OK - JUST HIT <NEW LINE> TO LEAVE A FIELD UNCHANGED";CHR$(31):PRINT:GOTO3760
4610 LPRINTCHR$(14);CHR$(25);"STOCK COUNT SHEET":LPRINTCHR$(15);"Item    A";
4620 LPRINTTAB(37);"Loc     S t o c k";STRING$(21," ");"On"
4630 LPRINT"Number  D  D e s c r i p t i o n";TAB(57);"C o u n t";STRING$(7," ");"Hand"
4640 LPRINTCHR$(32):RETURN
4650 CLS:PRINTTAB(23)"STOCK TAKE ANALYSIS":PRINTTAB(23)STRING$(19,CHR$(131))
4660 PRINT:PRINT"THIS OPTION ALLOWS YOU TO KEY IN THE PHYSICAL STOCK COUNT"
4662 PRINT"FOR EACH ITEM, AND TO COMPARE AGAINST THE QUANTITY ON THE"
4664 PRINT"COMPUTER FILE"
4670 PRINT"DIFFERENCES IN QUANTITY (& COST)ARE SHOWN"
4680 GOSUB490:PRINT@576,"DO YOU WISH TO PRINT THIS REPORT (Y/N)? ";:GL=1:GOSUB510:PR=0:IFIN$="Y"THENPR=1
4690 IFCF=1THEN1820
4700 CLS:PRINT" ITEM  A DESCRIPTION           STOCK COUNT ON HAND +-QTY +-VAL.";:PRINT
4710 PRINTSTRING$(6,CHR$(131));" ";CHR$(131);" ";STRING$(11,CHR$(131));STRING$(11," ");
4720 PRINTSTRING$(11,CHR$(131));" ";STRING$(7,CHR$(131));" ";STRING$ (5,CHR$ (131));" ";STRING$(6,CHR$(131))
4730 PRINT"(HIT '@' TO END)":H1#=0:H2#=0:IFPR<>1THEN4770ELSEGOSUB4740:GOTO4770
4740 GOSUB3670:LPRINTCHR$(14);CHR$(25);"STOCK TAKE ANALYSIS"
4750 LPRINTCHR$(15);"Item    A";TAB(38)"Stock     On      +/-     +/-$"
4760 LPRINT"Number  D  D e s c r i p t i o n       Count   Hand     Qty     Val.":LPRINTCHR$(32):RETURN
4770 GL=6:GOSUB510:IFCF=0THENIS$=IN$ELSEPRINT:GOTO4880
4780 GOSUB2830:IFK=0THENPRINT" ** ITEM NOT ON FILE **":GOTO4770
4790 GOSUB2990:GOSUB3070:GOSUB3080:PRINTTAB(7)IA$;" ";ID$;" ";
4800 GL=-5:GOSUB510:IFCF=0THENA=VAL(IN$)ELSEPRINT:GOTO4770
4810 AZ=IQ-A:A2#=AZ*IC
4820 PRINTTAB(44);USINGL0$;IQ;:PRINTUSINGL0$;AZ;:PRINTUSING"##"+L1$;A2#
4830 IFPR<>1THEN4870
4840 LPRINTIS$;"  ";IA$;"  ";ID$;"  ";USINGL0$;A;
4850 LPRINT"  ";USINGL0$;IQ;:LPRINT"  ";USINGL0$;AZ;
4860 LPRINTUSING"##"+L1$;A2#
4870 H1#=H1#+IQ*IC:H2#=H2#+A*IC:GOTO4770
4880 PRINT:PRINT"TOTAL COST VALUE FROM QTY ON HAND ";USINGL6$;H1#:PRINT"TOTAL COST VALUE FROM STOCK COUNT ";USINGL6$;H2#
4890 PRINT"TOTAL GAIN/LOSS";STRING$(19," ");USINGL6$;H2#-H1#
4900 PRINT:PRINT"HIT SPACE BAR TO CONTINUE";:GL=0:GH=0:GOSUB510
4910 IFPR<>1THEN1820
4920 LPRINT" ":LPRINT"TOTAL COST VALUE FROM QTY ON HAND ";USINGL6$;H1#
4930 LPRINT"TOTAL COST VALUE FROM STOCK COUNT ";USINGL6$;H2#:LPRINT"TOTAL GAIN/LOSS";STRING$(19," ");USINGL6$;H2#-H1#
4940 GOSUB4030:GOTO1820
4950 CLS:PRINTTAB(22)"DISK BACKUP UTILITY":PRINTTAB(22)STRING$(19,CHR$(131)):PRINT
4960 GOSUB490:PRINT@520,"DO YOU WISH TO PROCEED(Y/N)? "; :GL=1:GOSUB510
4970 IFIN$<>"Y"ORCF=1THENRETURN
4980 GOSUB3290:GOSUB3260
4989 REM The manual listing contains two lines labelled 4990. The first one, 4990 CLEAR50:LOAD350,R, is assumed to be an error in transcription and was removed 
4990 PRINT@128,"INSERT ORIGINAL DISKETTE IN DRIVE 0";CHR$(31)
5000 PRINT:PRINT"& INSERT DUPLICATE DISKETTE IN DRIVE 1":PRINT
5002 PRINT"HIT <NEW LINE> WHEN READY";:G$=""
5005 G$=INKEY$:IFG$=""THEN5005
5010 CLEAR3000:DEFINTA-Z:SS=0:SD=10000:DIMBF$(9)
5020 PRINT@128,CHR$(131):PRINT@448,"FORMATTING DESTINATION DISK";
5030 CMD"F",1
5040 FORTK=0TOINT(LOC(1)/10)
5050 PRINT@448,"READING TRACK";TK;STRING$(20," ");
5060 FORI=0TO9:GETBF$(I),SS+TK*10+I:NEXT
5070 PRINT@448,"WRITING/VERIFYING TRACK";TK;STRING$(20," ");
5080 FORI=0TO9:PUTBF$(I),SD+TK*10+I:NEXT
5090 NEXTTK:PRINT@640,"DISK BACKUP COMPLETE"
5100 CLEAR50:END
